home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / dbreg.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  16KB  |  525 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Borland Delphi Visual Component Library         }
  4. {                                                       }
  5. {       Copyright (c) 1995,99 Inprise Corporation       }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit DBReg;
  10.  
  11. interface
  12.  
  13. uses
  14.   SysUtils, Classes, DsgnIntf, DSDesign;
  15.  
  16. type
  17.   TDBStringProperty = class(TStringProperty)
  18.   public
  19.     function GetAttributes: TPropertyAttributes; override;
  20.     procedure GetValueList(List: TStrings); virtual;
  21.     procedure GetValues(Proc: TGetStrProc); override;
  22.   end;
  23.  
  24.   TDataFieldProperty = class(TDBStringProperty)
  25.   public
  26.     function GetDataSourcePropName: string; virtual;
  27.     procedure GetValueList(List: TStrings); override;
  28.   end;
  29.  
  30.   TDataFieldAggProperty = class(TDBStringProperty)
  31.   public
  32.     function GetDataSourcePropName: string; virtual;
  33.     procedure GetValueList(List: TStrings); override;
  34.   end;
  35.  
  36.   TDataSetEditor = class(TComponentEditor)
  37.   protected
  38.     function GetDSDesignerClass: TDSDesignerClass; virtual;
  39.   public
  40.     procedure ExecuteVerb(Index: Integer); override;
  41.     function GetVerb(Index: Integer): string; override;
  42.     function GetVerbCount: Integer; override;
  43.   end;
  44.  
  45.   TIndexFieldNamesProperty = class(TDBStringProperty)
  46.   public
  47.     procedure GetValueList(List: TStrings); override;
  48.   end;
  49.  
  50.   TIndexNameProperty = class(TDBStringProperty)
  51.   public
  52.     procedure GetValueList(List: TStrings); override;
  53.   end;
  54.  
  55. procedure Register;
  56.  
  57. implementation
  58.  
  59. uses
  60.   Windows, Controls, Forms, Mask, TypInfo, DBConsts, DsnDBCst, DB, DBCtrls,
  61.   DBGrids, DBCGrids, FileCtrl, ColnEdit, DBColnEd, FldLinks,
  62.   ActiveX, MaskProp, MaskText, ActnList, DBActns, DbOleCtl, DbOleEdt,
  63.   DBActRes;
  64.  
  65. { Utility Functions }
  66.  
  67. function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
  68. var
  69.   PropInfo: PPropInfo;
  70. begin
  71.   Result := nil;
  72.   PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
  73.   if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
  74.     Result := TObject(GetOrdProp(Instance, PropInfo)) as TPersistent;
  75. end;
  76.  
  77. { TDataSetEditor }
  78.  
  79. function TDataSetEditor.GetDSDesignerClass: TDSDesignerClass;
  80. begin
  81.   Result := TDSDesigner;
  82. end;
  83.  
  84. procedure TDataSetEditor.ExecuteVerb(Index: Integer);
  85. begin
  86.   if Index = 0 then
  87.     ShowFieldsEditor(Designer, TDataSet(Component), GetDSDesignerClass);
  88. end;
  89.  
  90. function TDataSetEditor.GetVerb(Index: Integer): string;
  91. begin
  92.   Result := SDatasetDesigner;
  93. end;
  94.  
  95. function TDataSetEditor.GetVerbCount: Integer;
  96. begin
  97.   Result := 1;
  98. end;
  99.  
  100. { TDataSetProperty }
  101.  
  102. type
  103.   TDataSetProperty = class(TComponentProperty)
  104.   private
  105.     FCheckProc: TGetStrProc;
  106.     procedure CheckComponent(const Value: string);
  107.   public
  108.     procedure GetValues(Proc: TGetStrProc); override;
  109.   end;
  110.  
  111. procedure TDataSetProperty.CheckComponent(const Value: string);
  112. var
  113.   J: Integer;
  114.   Dataset: TDataset;
  115. begin
  116.   Dataset := TDataset(Designer.GetComponent(Value));
  117.   for J := 0 to PropCount - 1 do
  118.     if TDataSource(GetComponent(J)).IsLinkedTo(Dataset) then
  119.       Exit;
  120.   FCheckProc(Value);
  121. end;
  122.  
  123. procedure TDataSetProperty.GetValues(Proc: TGetStrProc);
  124. begin
  125.   FCheckProc := Proc;
  126.   inherited GetValues(CheckComponent);
  127. end;
  128.  
  129. { TDataSourceProperty }
  130.  
  131. type
  132.   TDataSourceProperty = class(TComponentProperty)
  133.   private
  134.     FCheckProc: TGetStrProc;
  135.     procedure CheckComponent(const Value: string);
  136.   public
  137.     procedure GetValues(Proc: TGetStrProc); override;
  138.   end;
  139.  
  140. procedure TDataSourceProperty.CheckComponent(const Value: string);
  141. var
  142.   J: Integer;
  143.   DataSource: TDataSource;
  144. begin
  145.   DataSource := TDataSource(Designer.GetComponent(Value));
  146.   for J := 0 to PropCount - 1 do
  147.     if TDataSet(GetComponent(J)).IsLinkedTo(DataSource) then
  148.       Exit;
  149.   FCheckProc(Value);
  150. end;
  151.  
  152. procedure TDataSourceProperty.GetValues(Proc: TGetStrProc);
  153. begin
  154.   FCheckProc := Proc;
  155.   inherited GetValues(CheckComponent);
  156. end;
  157.  
  158. { TNestedDataSetProperty }
  159.  
  160. type
  161.   TNestedDataSetProperty = class(TComponentProperty)
  162.   private
  163.     FCheckProc: TGetStrProc;
  164.     procedure CheckComponent(const Value: string);
  165.   public
  166.     procedure GetValues(Proc: TGetStrProc); override;
  167.   end;
  168.  
  169. procedure TNestedDataSetProperty.CheckComponent(const Value: string);
  170. var
  171.   DataSet: TDataset;
  172. begin
  173.   DataSet := (GetComponent(0) as TDataSetField).DataSet;
  174.   if TDataset(Designer.GetComponent(Value)) <> DataSet then
  175.     FCheckProc(Value);
  176. end;
  177.  
  178. procedure TNestedDataSetProperty.GetValues(Proc: TGetStrProc);
  179. begin
  180.   FCheckProc := Proc;
  181.   inherited GetValues(CheckComponent);
  182. end;
  183.  
  184. { TDBStringProperty }
  185.  
  186. function TDBStringProperty.GetAttributes: TPropertyAttributes;
  187. begin
  188.   Result := [paValueList, paSortList, paMultiSelect];
  189. end;
  190.  
  191. procedure TDBStringProperty.GetValueList(List: TStrings);
  192. begin
  193. end;
  194.  
  195. procedure TDBStringProperty.GetValues(Proc: TGetStrProc);
  196. var
  197.   I: Integer;
  198.   Values: TStringList;
  199. begin
  200.   Values := TStringList.Create;
  201.   try
  202.     GetValueList(Values);
  203.     for I := 0 to Values.Count - 1 do Proc(Values[I]);
  204.   finally
  205.     Values.Free;
  206.   end;
  207. end;
  208.  
  209. function GetIndexDefs(Component: TPersistent): TIndexDefs;
  210. var
  211.   DataSet: TDataSet;
  212. begin
  213.   DataSet := Component as TDataSet;
  214.   Result := GetPropertyValue(DataSet, 'IndexDefs') as TIndexDefs;
  215.   if Assigned(Result) then
  216.   begin
  217.     Result.Updated := False;
  218.     Result.Update;
  219.   end;
  220. end;
  221.  
  222. { TIndexNameProperty }
  223.  
  224. procedure TIndexNameProperty.GetValueList(List: TStrings);
  225. begin
  226.   GetIndexDefs(GetComponent(0)).GetItemNames(List);
  227. end;
  228.  
  229. { TIndexFieldNamesProperty }
  230.  
  231. procedure TIndexFieldNamesProperty.GetValueList(List: TStrings);
  232. var
  233.   I: Integer;
  234.   IndexDefs: TIndexDefs;
  235. begin
  236.   IndexDefs := GetIndexDefs(GetComponent(0));
  237.   for I := 0 to IndexDefs.Count - 1 do
  238.     with IndexDefs[I] do
  239.       if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
  240.         List.Add(Fields);
  241. end;
  242.  
  243. { TDataFieldProperty }
  244.  
  245. function TDataFieldProperty.GetDataSourcePropName: string;
  246. begin
  247.   Result := 'DataSource';
  248. end;
  249.  
  250. procedure TDataFieldProperty.GetValueList(List: TStrings);
  251. var
  252.   DataSource: TDataSource;
  253. begin
  254.   DataSource := GetPropertyValue(GetComponent(0), GetDataSourcePropName) as TDataSource;
  255.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  256.     DataSource.DataSet.GetFieldNames(List);
  257. end;
  258.  
  259. { TDataFieldAggProperty }
  260.  
  261. function TDataFieldAggProperty.GetDataSourcePropName: string;
  262. begin
  263.   Result := 'DataSource';
  264. end;
  265.  
  266. procedure TDataFieldAggProperty.GetValueList(List: TStrings);
  267. var
  268.   DataSource: TDataSource;
  269.   AggList: TStringList;
  270. begin
  271.   DataSource := GetPropertyValue(GetComponent(0), GetDataSourcePropName) as TDataSource;
  272.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  273.   begin
  274.     DataSource.DataSet.GetFieldNames(List);
  275.     if DataSource.DataSet.AggFields.Count > 0 then
  276.     begin
  277.       AggList := TStringList.Create;
  278.       try
  279.         DataSource.DataSet.AggFields.GetFieldNames(AggList);
  280.         List.AddStrings(AggList);
  281.       finally
  282.         AggList.Free;
  283.       end;
  284.     end;
  285.   end;
  286. end;
  287.  
  288. { TLookupSourceProperty }
  289.  
  290. type
  291.   TLookupSourceProperty = class(TDBStringProperty)
  292.   public
  293.     procedure GetValueList(List: TStrings); override;
  294.   end;
  295.  
  296. procedure TLookupSourceProperty.GetValueList(List: TStrings);
  297. begin
  298.   with GetComponent(0) as TField do
  299.     if DataSet <> nil then DataSet.GetFieldNames(List);
  300. end;
  301.  
  302. { TLookupDestProperty }
  303.  
  304. type
  305.   TLookupDestProperty = class(TDBStringProperty)
  306.   public
  307.     procedure GetValueList(List: TStrings); override;
  308.   end;
  309.  
  310. procedure TLookupDestProperty.GetValueList(List: TStrings);
  311. begin
  312.   with GetComponent(0) as TField do
  313.     if LookupDataSet <> nil then LookupDataSet.GetFieldNames(List);
  314. end;
  315.  
  316. { TListFieldProperty }
  317.  
  318. type
  319.   TListFieldProperty = class(TDataFieldProperty)
  320.   public
  321.     function GetDataSourcePropName: string; override;
  322.   end;
  323.  
  324. function TListFieldProperty.GetDataSourcePropName: string;
  325. begin
  326.   Result := 'ListSource';
  327. end;
  328.  
  329. { TLookupFieldProperty }
  330.  
  331. type
  332.   TLookupFieldProperty = class(TDataFieldProperty)
  333.   public
  334.     function GetDataSourcePropName: string; override;
  335.   end;
  336.  
  337. function TLookupFieldProperty.GetDataSourcePropName: string;
  338. begin
  339.   Result := 'LookupSource';
  340. end;
  341.  
  342. { TLookupIndexProperty }
  343.  
  344. type
  345.   TLookupIndexProperty = class(TLookupFieldProperty)
  346.   public
  347.     procedure GetValueList(List: TStrings); override;
  348.   end;
  349.  
  350. procedure TLookupIndexProperty.GetValueList(List: TStrings);
  351. var
  352.   DataSource: TDataSource;
  353. begin
  354.   DataSource := GetPropertyValue(GetComponent(0), GetDataSourcePropName) as TDataSource;
  355.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  356.     DataSource.DataSet.GetFieldNames(List);
  357. end;
  358.  
  359. { TDBImageEditor }
  360.  
  361. type
  362.   TDBImageEditor = class(TDefaultEditor)
  363.   public
  364.     procedure Copy; override;
  365.   end;
  366.  
  367. procedure TDBImageEditor.Copy;
  368. begin
  369.   TDBImage(Component).CopyToClipboard;
  370. end;
  371.  
  372. type
  373.   TDBGridColumnsProperty = class(TClassProperty)
  374.   public
  375.     procedure Edit; override;
  376.     function GetAttributes: TPropertyAttributes; override;
  377.   end;
  378.  
  379. procedure TDBGridColumnsProperty.Edit;
  380. begin
  381.   ShowCollectionEditorClass(Designer, TDBGridColumnsEditor,
  382.     GetComponent(0) as TComponent, TDBGridColumns(GetOrdValue), GetName);
  383. end;
  384.  
  385. function TDBGridColumnsProperty.GetAttributes: TPropertyAttributes;
  386. begin
  387.   Result := [paDialog, paReadOnly];
  388. end;
  389.  
  390.  
  391. { TDBGridEditor }
  392. type
  393.   TDBGridEditor = class(TComponentEditor)
  394.   public
  395.     procedure ExecuteVerb(Index: Integer); override;
  396.     function GetVerb(Index: Integer): string; override;
  397.     function GetVerbCount: Integer; override;
  398.   end;
  399.  
  400. procedure TDBGridEditor.ExecuteVerb(Index: Integer);
  401. begin
  402.   ShowCollectionEditorClass(Designer, TDBGridColumnsEditor, Component,
  403.     TDBGrid(Component).Columns, 'Columns');
  404. end;
  405.  
  406. function TDBGridEditor.GetVerb(Index: Integer): string;
  407. begin
  408.   Result := SDBGridColEditor;
  409. end;
  410.  
  411. function TDBGridEditor.GetVerbCount: Integer;
  412. begin
  413.   Result := 1;
  414. end;
  415.  
  416. { TColumnDataFieldEditor }
  417.  
  418. type
  419.   TColumnDataFieldProperty = class(TDBStringProperty)
  420.     procedure GetValueList(List: TStrings); override;
  421.   end;
  422.  
  423. procedure TColumnDataFieldProperty.GetValueList(List: TStrings);
  424. var
  425.   Grid: TCustomDBGrid;
  426.   DataSource: TDataSource;
  427. begin
  428.   Grid := (GetComponent(0) as DBGrids.TColumn).Grid;
  429.   if (Grid = nil) then Exit;
  430.   DataSource := GetPropertyValue(Grid, 'DataSource') as TDataSource;
  431.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  432.     DataSource.DataSet.GetFieldNames(List);
  433. end;
  434.  
  435. { Registration }
  436.  
  437. procedure Register;
  438. begin
  439.   { Database Components are excluded from the STD SKU }
  440.   if GDAL <> LongWord(-16) then
  441.   begin
  442.     RegisterComponents(srDAccess, [TDataSource]);
  443.     RegisterComponents(srDControls, [TDBGrid, TDBNavigator, TDBText,
  444.       TDBEdit, TDBMemo, TDBImage, TDBListBox, TDBComboBox, TDBCheckBox,
  445.       TDBRadioGroup, TDBLookupListBox, TDBLookupComboBox, TDBRichEdit]);
  446.     RegisterNonActiveX([TDataSource, TCustomDBGrid, TDBNavigator, TDBText,
  447.       TDBEdit, TDBMemo, TDBImage, TDBListBox, TDBComboBox, TDBCheckBox,
  448.       TDBRadioGroup, TDBLookupListBox, TDBLookupComboBox, TDBRichEdit,
  449.       TDBLookupControl], axrIncludeDescendants);
  450.     RegisterNonActiveX([TDBCtrlGrid], axrIncludeDescendants);
  451.     RegisterComponents(srDControls, [TDBCtrlGrid]);
  452.     RegisterNoIcon([TField]);
  453.     RegisterFields([TStringField, TIntegerField, TSmallintField, TWordField,
  454.       TFloatField, TCurrencyField, TBCDField, TBooleanField, TDateField,
  455.       TVarBytesField, TBytesField, TTimeField, TDateTimeField,
  456.       TBlobField, TMemoField, TGraphicField, TAutoIncField, TLargeintField,
  457.       TADTField, TArrayField, TDataSetField, TReferenceField, TAggregateField,
  458.       TWideStringField, TVariantField, TGuidField, TInterfaceField, TIDispatchField]);
  459.     RegisterPropertyEditor(TypeInfo(TDataSet), TDataSource, 'DataSet', TDataSetProperty);
  460.     RegisterPropertyEditor(TypeInfo(TDataSet), TDataSetField, 'NestedDataSet', TNestedDataSetProperty);
  461.     RegisterPropertyEditor(TypeInfo(TDataSource), TDataSet, 'MasterSource', TDataSourceProperty);
  462.     RegisterPropertyEditor(TypeInfo(TDataSource), TDataSet, 'DataSource', TDataSourceProperty);
  463.     RegisterPropertyEditor(TypeInfo(string), TField, 'KeyFields', TLookupSourceProperty);
  464.     RegisterPropertyEditor(TypeInfo(string), TField, 'LookupKeyFields', TLookupDestProperty);
  465.     RegisterPropertyEditor(TypeInfo(string), TField, 'LookupResultField', TLookupDestProperty);
  466.     RegisterPropertyEditor(TypeInfo(string), TComponent, 'DataField', TDataFieldProperty);
  467.     RegisterPropertyEditor(TypeInfo(string), TDBLookupControl, 'KeyField', TListFieldProperty);
  468.     RegisterPropertyEditor(TypeInfo(string), TDBLookupControl, 'ListField', TListFieldProperty);
  469.     RegisterPropertyEditor(TypeInfo(string), TWinControl, 'LookupField', TLookupIndexProperty);
  470.     RegisterPropertyEditor(TypeInfo(string), TWinControl, 'LookupDisplay', TLookupFieldProperty);
  471.     RegisterPropertyEditor(TypeInfo(string), TDBEdit, 'EditMask', TMaskProperty);
  472.     RegisterPropertyEditor(TypeInfo(string), TField, 'EditMask', TMaskProperty);
  473.     RegisterPropertyEditor(TypeInfo(string), TColumn, 'FieldName', TColumnDataFieldProperty);
  474.     RegisterPropertyEditor(TypeInfo(TDBGridColumns), TCustomDBGrid, '', TDBGridColumnsProperty);
  475.     RegisterPropertyEditor(TypeInfo(string), TDBText, 'DataField', TDataFieldAggProperty);
  476.     RegisterPropertyEditor(TypeInfo(string), TDBEdit, 'DataField', TDataFieldAggProperty);
  477.     RegisterPropertyEditor(TypeInfo(TDataBindings), TDBOleControl, 'DataBindings', TDataBindProperty);
  478.     RegisterComponentEditor(TDataset, TDataSetEditor);
  479.     RegisterComponentEditor(TDBImage, TDBImageEditor);
  480.     RegisterComponentEditor(TDBGrid, TDBGridEditor);
  481.     RegisterComponentEditor(TDBOleControl, TDataBindEditor);
  482.  
  483.     { DataSet action registration }
  484.     RegisterActions('Dataset', [TDataSetFirst, TDataSetPrior, TDataSetNext,
  485.       TDataSetLast, TDataSetInsert, TDataSetDelete, TDataSetEdit, TDataSetPost,
  486.       TDataSetCancel, TDataSetRefresh], TStandardDatasetActions);
  487.  
  488.     { Property Category registration }
  489.     RegisterPropertiesInCategory(TDatabaseCategory,
  490.       ['SQL*', 'Filter*', 'OnFilter*', 'RequestLive',
  491.        TypeInfo(TDataSet), TypeInfo(TDataSource),
  492.        TypeInfo(TParams), TypeInfo(TDBGridColumns),
  493.        TypeInfo(TCheckConstraints), TypeInfo(TDataBindings)]);
  494.  
  495.     RegisterPropertiesInCategory(TDatabaseCategory, TDataSet,
  496.       ['*Field', '*Fields', 'Index*', 'Lookup*', '*Defs', 'ObjectView', 'Table*',
  497.        'Param*', 'Cache*', 'Lock*', 'Cursor*']);
  498.  
  499.     RegisterPropertiesInCategory(TDatabaseCategory, TField,
  500.       ['*Field', '*Fields']);
  501.  
  502.     RegisterPropertiesInCategory(TDatabaseCategory, TWinControl,
  503.       ['LookupField', 'LookupDisplay']);
  504.  
  505.     RegisterPropertiesInCategory(TDatabaseCategory, TDBLookupControl,
  506.       ['*Field', '*FieldIndex']);
  507.  
  508.     RegisterPropertyInCategory(TDatabaseCategory, TComponent, 'DataField');
  509.     RegisterPropertyInCategory(TDatabaseCategory, TColumn, 'FieldName');
  510.     
  511.     { Localizable properties }
  512.     RegisterPropertiesInCategory(TLocalizableCategory, TField, 
  513.       ['DisplayFormat', 'DisplayLabel', 'DisplayValues', 'EditFormat', 'ConstraintErrorMessage']); { Do not localize }
  514.     RegisterPropertiesInCategory(TLocalizableCategory, TDBRadioGroup, ['Columns']);  { Do not localize }
  515.     RegisterPropertiesInCategory(TLocalizableCategory, TDBCheckBox, ['ValueChecked', 'ValueUnchecked']); { Do not localize }
  516.     RegisterPropertiesInCategory(TLocalizableCategory, TColumn, ['Picklist']); { Do not localize }
  517.    
  518.     RegisterPropertiesInCategory(TLocalizableCategory, { by TypeInfo }
  519.       [TypeInfo(TCheckConstraints), 
  520.        TypeInfo(TColumnTitle)]);
  521.   end;
  522. end;
  523.  
  524. end.
  525.